home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-bug.el.z / ilisp-bug.el
Encoding:
Text File  |  1998-05-21  |  3.7 KB  |  125 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-bug.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23.  
  24. ;;;
  25. ;;; ILISP bug stuff.
  26. ;;;
  27.  
  28. ;;;
  29. ;;;%Bugs
  30. (defun ilisp-bug ()
  31.   "Generate an ilisp bug report."
  32.   (interactive)
  33.   (let ((buffer 
  34.      (if (y-or-n-p 
  35.           (format "Is %s the buffer where the error occurred? " 
  36.               (buffer-name (current-buffer))))
  37.          (current-buffer))))
  38.     (if (or (not buffer) (not (mail)))
  39.     (progn
  40.       (message 
  41.        (if buffer 
  42.            "Can't send bug report until mail buffer is empty."
  43.            "Switch to the buffer where the error occurred."))
  44.       (beep))
  45.       (insert ilisp-bugs-to)
  46.       (search-forward (concat "\n" mail-header-separator "\n"))
  47.       (insert "\nYour problem: \n\n")
  48.       (insert "Type C-c C-c to send\n")
  49.       (insert "======= Emacs state below: for office use only =======\n")
  50.       (forward-line 1)
  51.       (insert (emacs-version))
  52.       (insert 
  53.        (format "\nWindow System: %s %s" window-system window-system-version))
  54.       (let ((mode (save-excursion (set-buffer buffer) major-mode))
  55.         (match "popper-\\|completer-")
  56.         (val-buffer buffer)
  57.         string)
  58.     (if (or (memq mode lisp-source-modes) (memq mode ilisp-modes))
  59.         (progn
  60.           (setq match (concat "ilisp-\\|comint-\\|lisp-" match)
  61.             val-buffer (save-excursion (set-buffer buffer)
  62.                            (or (ilisp-buffer) buffer)))
  63.           (mapcar (function (lambda (dialect)
  64.                   (setq match (concat (format "%s-\\|" (car dialect))
  65.                               match))))
  66.               ilisp-dialects)
  67.           (save-excursion
  68.         (set-buffer buffer)
  69.         (let ((point (point))
  70.               (start (lisp-defun-begin))
  71.               (end (lisp-end-defun-text t)))
  72.           (setq string
  73.             (format "
  74. Mode: %s
  75. Start: %s
  76. End: %s
  77. Point: %s
  78. Point-max: %s
  79. Code: %s"
  80.                 major-mode start end point (point-max)
  81.                 (buffer-substring start end)))))
  82.           (insert string)))
  83.     (mapatoms
  84.      (function (lambda (symbol)
  85.              (if (and (boundp symbol)
  86.                   (string-match match (format "%s" symbol))
  87.                   (not (eq symbol 'ilisp-documentation)))
  88.              (let ((val (save-excursion
  89.                       (set-buffer val-buffer) 
  90.                       (symbol-value symbol))))
  91.                (if val
  92.                    (insert (format "\n%s: %s" symbol val))))))))
  93.     (insert (format "\nLossage: %s" (key-description (recent-keys))))
  94.     (if (and (or (memq mode lisp-source-modes)
  95.              (memq mode ilisp-modes))
  96.          (ilisp-buffer) 
  97.          (memq 'clisp (ilisp-value 'ilisp-dialect t))
  98.          (not (cdr (ilisp-value 'comint-send-queue))))
  99.         (progn
  100.           (insert (format "\nLISP: %s"
  101.                   (comint-remove-whitespace
  102.                    (car (comint-send
  103.                      (save-excursion
  104.                        (set-buffer buffer)
  105.                        (ilisp-process))
  106.                      "(lisp-implementation-version)"
  107.                      t t 'version)))))
  108.           (insert (format "\n*FEATURES*: %s"
  109.                   (comint-remove-whitespace
  110.                    (car (comint-send
  111.                      (save-excursion
  112.                        (set-buffer buffer)
  113.                        (ilisp-process))
  114.                      "(let ((*print-length* nil)
  115.                        (*print-level* nil))
  116.                    (print *features*)
  117.                    nil)"
  118.                      t t 'version)))))))
  119.     (insert ?\n)
  120.     (goto-char (point-min))
  121.     (re-search-forward "^Subject")
  122.     (end-of-line)
  123.     (message "Send with sendmail or your favorite mail program.")))))
  124.  
  125.